home *** CD-ROM | disk | FTP | other *** search
/ Pascal Super Library / Pascal Super Library (CW International)(1997).bin / SORT_UTL / ASORTS / TSTSRT.PAS < prev   
Pascal/Delphi Source File  |  1991-02-28  |  5KB  |  137 lines

  1. program tstsrt;
  2. { Exercises most of the facilities of the ASORTS unit }
  3.  
  4. uses asorts;
  5.  
  6. { $define MONITOR} {<-- MONITOR needs to be defined in ASORTS.PAS
  7.                         also }
  8.  
  9. const
  10.   max = 19; { must be byte-sized }
  11.  
  12. type
  13.   list = array[1..max] of integer;
  14.  
  15. var
  16.   data: list;
  17.   i: integer;
  18.   b:integer;
  19.  
  20. const
  21.   bs : set of byte = [];
  22.   cmax:word=0;
  23.  
  24. function intcomp(var a,b):longint; far;
  25. var int1: integer absolute a;
  26.     int2: integer absolute b;
  27. begin
  28.   if int1<int2 then intcomp:=-1
  29.   else if int1=int2 then intcomp:=0
  30.   else intcomp:=1;
  31. end;
  32.  
  33. procedure datamon; far; var i:byte; begin
  34.   for i:=1 to cmax do write(data[i]:4); writeln; end;
  35.  
  36. begin {tstsrt}
  37.   Writeln('Now generating up to ',max,' random numbers...');
  38.   Randomize;
  39.   for i:=1 to max do begin
  40.       b:=random(256);
  41.  
  42.       { If "b" has already been generated, "lsearch" should find it;
  43.         otherwise "lsearch" should add it to the end. }
  44.  
  45.       if b in bs then
  46.          if lsearch(b,data,cmax,sizeof(integer),intcomp)>cmax then
  47.             writeln('Error in "lsearch": element not found ',b)
  48.          else
  49.       else if lsearch(b,data,cmax,sizeof(integer),intcomp)<=cmax then
  50.          writeln('Error in "lsearch": invalid element inserted ',b)
  51.       else begin bs:=bs + [b]; inc(cmax) end; end;
  52.   datamon; write(' (Press return)'); readln;
  53.  
  54.   Writeln('Now sorting ',cmax,' random numbers...');
  55.  
  56. {$ifdef MONITOR}  { This will let us keep track of the how the sort is
  57.                   progressing }
  58. { !!! MONITOR must be defined in ASORTS for this to work }
  59. asorts.monitor:=datamon;
  60. {$endif}
  61.  
  62.   qsort(data,cmax,sizeof(integer),intcomp);
  63.  
  64. {$ifdef MONITOR}
  65. { This is not important for this program, but if you call "qsort" from
  66.   multiple locations, what the procedure does might not always make sense.
  67.   So, we turn the monitor off. }
  68.  
  69. asorts.nullmonitor;
  70.  
  71. {$else}
  72.   datamon;
  73. {$endif}
  74.   write(' (Press return)'); readln;
  75.   writeln('Now searching for ',cmax,' sorted numbers...');
  76.   for i:=0 to 255 do
  77.       { All byte values will be sought.  It would be an error for
  78.         "bsearch" to find a value that was not inserted into the
  79.         array.  Also, to fail to find a value that was inserted
  80.         into the array }
  81.       if bsearch(i,data,cmax,sizeof(integer),intcomp)=0 then
  82.          if i in bs then
  83.             Writeln('Error in "bsearch": element not found ',i)
  84.          else
  85.       else if not (i in bs) then
  86.          writeln('Error in "bsearch": invalid element found ',i);
  87.   writeln('....Search complete.');
  88.  
  89.   { We are now going to exercise the submove and xsubmove procedures
  90.     in ASORTS.  For the simple submove, the first five elements of "data"
  91.     are going to be moved to "pseudo" array that starts at data[9].  The
  92.     target array is presumed to consist of elements that are two integers
  93.     in size.  So, the moved values will wind up in every other integer
  94.     displayed.}
  95.   writeln('Now doing a simple array submove ... (1->9,2->11,...5->17)');
  96.   submove(data[1],data[9],5,2,4);
  97.   datamon; write(' (Press return)'); readln;
  98.  
  99.  
  100.   { For the more general "xsubmove", we are going to presume that the
  101.     source array is also two integers per element, but we only want to move
  102.     the first element.  (The source and target are overlayed in this example
  103.     so that what is seen are pairs of numbers appear in "data".) }
  104.   writeln('Now doing a complex array submove ...(1->2,3->4,...9->10)');
  105.   xsubmove(data[1],data[2],5,4,4,2);
  106.   datamon; write(' (Press return)'); readln;
  107.  
  108.   { Now put 255 into the even slots }
  109.   writeln('Now interlacing "255" into the array');
  110.   b:=255;
  111.   subfill(b,data[2],9,2,4);
  112.   datamon; write(' (Press return)'); readln;
  113.  
  114.   { Now put 0 everywhere }
  115.   writeln('Now filling array with 0''s...');
  116.   b:=0;
  117.   fill(b,data,19,sizeof(integer));
  118.   datamon; write(' (Press return)'); readln;
  119.  
  120.   { Now let's tryout the binary insertion procedure }
  121.   writeln('Now creating a new, sorted random array ... ');
  122.   cmax:=0; bs:=[];
  123.   for i:=1 to max do begin
  124.       b:=random(256);
  125.       b:=binsert(b,data,cmax,sizeof(integer),intcomp);
  126.       inc(cmax); end;
  127.   datamon; write(' (Press return)'); readln;
  128.  
  129.   { That only leaves "shuffle" to be exercised, so let's mess up everything
  130.     before we exit. }
  131.   writeln('Now shuffling ',cmax,' numbers...');
  132.   shuffle(data,cmax,sizeof(integer));
  133.   datamon; write(' (Press return)'); readln;
  134.  
  135.   writeln('Done.');
  136. end.
  137.